home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / subckt.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  9KB  |  279 lines
  1. /* subckt.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  33.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  34. } flags_;
  35.  
  36. #define flags_1 flags_
  37.  
  38. struct {
  39.     doublereal value[200000];
  40. } blank_;
  41.  
  42. #define blank_1 blank_
  43.  
  44. struct {
  45.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  46.         sfactr;
  47.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  48.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  49. } status_;
  50.  
  51. #define status_1 status_
  52.  
  53. /* Table of constant values */
  54.  
  55. static integer c__20 = 20;
  56. static integer c__1 = 1;
  57.  
  58. /*<       subroutine subckt >*/
  59. /* Subroutine */ int subckt_()
  60. {
  61.     /* Format strings */
  62.     static char fmt_251[] = "(\0020*error*:  \002,a8,\002 has different numb\
  63. er of nodes than \002,a8/)";
  64.     static char fmt_261[] = "(\0020*error*:  subcircuit \002,a8,\002 is defi\
  65. ned recursively\002/)";
  66.  
  67.     /* System generated locals */
  68.     integer i_1, i_2;
  69.     doublereal d_1;
  70.  
  71.     /* Builtin functions */
  72.     integer s_wsfe(), do_fio(), e_wsfe();
  73.  
  74.     /* Local variables */
  75.     extern /* Subroutine */ int find_();
  76.     static integer loce, locx, locs, locv;
  77.     extern /* Subroutine */ int getm4_(), copy4_();
  78.     static doublereal asnam;
  79.     static integer inodi;
  80.     static doublereal axnam;
  81.     static integer itemp, nxnod, inodx, locsv, id;
  82.     extern /* Subroutine */ int addelt_(), fndnam_();
  83. #define nodplc ((integer *)&blank_1)
  84. #define cvalue ((complex *)&blank_1)
  85.     static integer isbptr;
  86.     extern /* Subroutine */ int sizmem_();
  87.     static integer nssnod;
  88.     extern /* Subroutine */ int clrmem_();
  89.     static integer loc;
  90.  
  91.     /* Fortran I/O blocks */
  92.     static cilist io__17 = { 0, 0, 0, fmt_251, 0 };
  93.     static cilist io__19 = { 0, 0, 0, fmt_261, 0 };
  94.  
  95.  
  96. /*<       implicit double precision (a-h,o-z) >*/
  97.  
  98. /*     this routine drives the expansion of subcircuit calls. */
  99.  
  100. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  101. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  102. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  103. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  104. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  105. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  106. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  107. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  108. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  109. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  110. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  111. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  112. /* spice version 2g.6  sccsid=flags 3/15/83 */
  113. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  114. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  115. /* spice version 2g.6  sccsid=blank 3/15/83 */
  116. /*<       common /blank/ value(200000) >*/
  117. /* spice version 2g.6  sccsid=status 3/15/83 */
  118. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  119. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  120. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  121. /*<       integer nodplc(64) >*/
  122. /*<       complex cvalue(32) >*/
  123. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  124.  
  125.  
  126. /* ... avoid 'call by value' problems, make inodi, inodx arrays */
  127. /* ... in routines which receive them as parameters ]]] */
  128. /*<       locx=locate(19) >*/
  129.     locx = cirdat_1.locate[18];
  130. /*<    10 if (locx.eq.0) go to 300 >*/
  131. L10:
  132.     if (locx == 0) {
  133.     goto L300;
  134.     }
  135. /*<       locs=nodplc(locx+3) >*/
  136.     locs = nodplc[locx + 2];
  137. /*<       asnam=value(iunsat+locs) >*/
  138.     asnam = blank_1.value[tabinf_1.iunsat + locs - 1];
  139. /*<       call fndnam(asnam,locx-1,locx+3,20) >*/
  140.     i_1 = locx - 1;
  141.     i_2 = locx + 3;
  142.     fndnam_(&asnam, &i_1, &i_2, &c__20);
  143. /*<       if (nogo.ne.0) go to 300 >*/
  144.     if (flags_1.nogo != 0) {
  145.     goto L300;
  146.     }
  147. /*<       locs=nodplc(locx+3) >*/
  148.     locs = nodplc[locx + 2];
  149.  
  150. /*  check for recursion */
  151.  
  152. /*<       isbptr=nodplc(locx-1) >*/
  153.     isbptr = nodplc[locx - 2];
  154. /*<    20 if (isbptr.eq.0) go to 30 >*/
  155. L20:
  156.     if (isbptr == 0) {
  157.     goto L30;
  158.     }
  159. /*<       if (locs.eq.nodplc(isbptr+3)) go to 260 >*/
  160.     if (locs == nodplc[isbptr + 2]) {
  161.     goto L260;
  162.     }
  163. /*<       isbptr=nodplc(isbptr-1) >*/
  164.     isbptr = nodplc[isbptr - 2];
  165. /*<       go to 20 >*/
  166.     goto L20;
  167.  
  168.  
  169. /*<    30 call sizmem(nodplc(locx+2),nxnod) >*/
  170. L30:
  171.     sizmem_(&nodplc[locx + 1], &nxnod);
  172. /*<       call sizmem(nodplc(locs+2),nssnod) >*/
  173.     sizmem_(&nodplc[locs + 1], &nssnod);
  174. /*<       if (nxnod.ne.nssnod) go to 250 >*/
  175.     if (nxnod != nssnod) {
  176.     goto L250;
  177.     }
  178. /*<       call getm4(inodx,nssnod) >*/
  179.     getm4_(&inodx, &nssnod);
  180. /*<       call getm4(inodi,nssnod) >*/
  181.     getm4_(&inodi, &nssnod);
  182. /*<       itemp=nodplc(locs+2) >*/
  183.     itemp = nodplc[locs + 1];
  184. /*<       call copy4(nodplc(itemp+1),nodplc(inodx+1),nssnod) >*/
  185.     copy4_(&nodplc[itemp], &nodplc[inodx], &nssnod);
  186. /*<       itemp=nodplc(locx+2) >*/
  187.     itemp = nodplc[locx + 1];
  188. /*<       call copy4(nodplc(itemp+1),nodplc(inodi+1),nxnod) >*/
  189.     copy4_(&nodplc[itemp], &nodplc[inodi], &nxnod);
  190.  
  191. /*  add elements of subcircuit to nominal circuit */
  192.  
  193. /*<       loc=nodplc(locs+3) >*/
  194.     loc = nodplc[locs + 2];
  195. /*<   100 if (loc.eq.0) go to 200 >*/
  196. L100:
  197.     if (loc == 0) {
  198.     goto L200;
  199.     }
  200. /*<       id=nodplc(loc-1) >*/
  201.     id = nodplc[loc - 2];
  202. /*<       if (id.eq.20) go to 110 >*/
  203.     if (id == 20) {
  204.     goto L110;
  205.     }
  206. /*<       call find(dble(jelcnt(id)),id,loce,1) >*/
  207.     d_1 = (doublereal) cirdat_1.jelcnt[id - 1];
  208.     find_(&d_1, &id, &loce, &c__1);
  209. /*<       nodplc(loce-1)=locx >*/
  210.     nodplc[loce - 2] = locx;
  211. /*<       call addelt(loce,loc,id,inodx,inodi,nxnod) >*/
  212.     addelt_(&loce, &loc, &id, &inodx, &inodi, &nxnod);
  213. /*<   110 loc=nodplc(loc) >*/
  214. L110:
  215.     loc = nodplc[loc - 1];
  216. /*<       go to 100 >*/
  217.     goto L100;
  218.  
  219.  
  220. /*<   200 call clrmem(inodx) >*/
  221. L200:
  222.     clrmem_(&inodx);
  223. /*<       call clrmem(inodi) >*/
  224.     clrmem_(&inodi);
  225. /*<       locx=nodplc(locx) >*/
  226.     locx = nodplc[locx - 1];
  227. /*<       go to 10 >*/
  228.     goto L10;
  229.  
  230. /*  errors */
  231.  
  232. /*<   250 locv=nodplc(locx+1) >*/
  233. L250:
  234.     locv = nodplc[locx];
  235. /*<       axnam=value(locv) >*/
  236.     axnam = blank_1.value[locv - 1];
  237. /*<       locv=nodplc(locs+1) >*/
  238.     locv = nodplc[locs];
  239. /*<       asnam=value(locv) >*/
  240.     asnam = blank_1.value[locv - 1];
  241. /*<       write (iofile,251) axnam,asnam >*/
  242.     io__17.ciunit = status_1.iofile;
  243.     s_wsfe(&io__17);
  244.     do_fio(&c__1, (char *)&axnam, (ftnlen)sizeof(doublereal));
  245.     do_fio(&c__1, (char *)&asnam, (ftnlen)sizeof(doublereal));
  246.     e_wsfe();
  247. /*<   251 format('0*error*:  ',a8,' has different number of nodes than ',a8/ >*/
  248. /*<      1) >*/
  249. /*<       nogo=1 >*/
  250.     flags_1.nogo = 1;
  251. /*<       go to 300 >*/
  252.     goto L300;
  253. /*<   260 locsv=nodplc(locs+1) >*/
  254. L260:
  255.     locsv = nodplc[locs];
  256. /*<       asnam=value(locsv) >*/
  257.     asnam = blank_1.value[locsv - 1];
  258. /*<       write (iofile,261) asnam >*/
  259.     io__19.ciunit = status_1.iofile;
  260.     s_wsfe(&io__19);
  261.     do_fio(&c__1, (char *)&asnam, (ftnlen)sizeof(doublereal));
  262.     e_wsfe();
  263. /*<   261 format('0*error*:  subcircuit ',a8,' is defined recursively'/) >*/
  264. /*<       nogo=1 >*/
  265.     flags_1.nogo = 1;
  266.  
  267. /*  finished */
  268.  
  269. /*<   300 return >*/
  270. L300:
  271.     return 0;
  272. /*<       end >*/
  273. } /* subckt_ */
  274.  
  275. #undef cvalue
  276. #undef nodplc
  277.  
  278.  
  279.